#lang plai-typed

;; TODO: Add func define in ExprS
(define-type MisspelledAnimal
    [caml (humps : number)]
    [yacc (height : number)])
(define l '(+ 1 2))
(define f (first (s-exp->list l)))

;;DONE Rename Arith to ExprS
(define-type FunDefC
  [fdC (name : symbol) (arg : symbol) (body : ExprC)])

(define-type ExprC
  [numC (n : number)]
  [idC (s : symbol)]
  [appC (func : symbol) (arg : ExprC)]
  [plusC (l : ExprC) (r : ExprC)]
  [multC (l : ExprC) (r : ExprC)])

(define-type ExprS
  [numS (n : number)]
  [plusS (l : ExprS) (r : ExprS)]
  [bminusS (l : ExprS) (r : ExprS)]
  [multS (l : ExprS) (r : ExprS)]
  [unimusS (e : ExprS)])

;; Desugaring function is a IR-transformer like babel
(define (desugar [as : ExprS]) : ExprC
  (type-case ExprS as
    [numS (n) (numC n)]
    [plusS (l r) (plusC (desugar l)
                        (desugar r))]
    [multS (l r) (multC (desugar l)
                        (desugar r))]
    [unimusS (e) (desugar (bminusS (numS 0) e))]
    [bminusS (l r) (plusC (desugar l)
                          (multC (numC -1) (desugar r)))]))

(define (parse [s : s-expression]) : ExprS
  (cond
    [(s-exp-number? s) (numS (s-exp->number s))]
    [(s-exp-list? s)
     (let ([sl (s-exp->list s)])
       (case (s-exp->symbol (first sl))
         [(+) (plusS (parse (second sl)) (parse (third sl)))]
         [(*) (multS (parse (second sl)) (parse (third sl)))]
         [(-) (cond [(eq? (length sl) 3) (bminusS (parse (second sl)) (parse (third sl)))]
                    [(eq? (length sl) 2) (unimusS (parse (second sl)))])]
         
         [else (error 'parse "invalid list input")]))]
    [else (error 'parse "invalid input")]))

(define (desugar-parse [expr : s-expression]) : ExprC
  (desugar (parse expr)))
(define (subst [what : ExprC] [for : symbol] [in : ExprC]) : ExprC
  (type-case ExprC in
    [numC (n) in]
    [idC  (s) (cond
                [(symbol=? s for) what]
                [else in])]
    [appC (f a) (appC f (subst what for a))]
    [plusC (l r) (plusC (subst what for l)
                        (subst what for r))]
    [multC (l r) (multC (subst what for l)
                        (subst what for r))]))
 (define (get-fundef [n : symbol] [fds : (listof FunDefC)]) : FunDefC
   (cond
     [(empty? fds) (error 'get-fundef "reference to undefined function")]
     [(cons? fds) (cond
                    [(equal? n (fdC-name (first fds))) (first fds)]
                    [else (get-fundef n (rest fds))])]))
(define (interp [e : ExprC] [fds : (listof FunDefC)]) : number
  (type-case ExprC e
    [numC (n) n]
    [plusC (l r) (+ (interp l fds) (interp r fds))]
    [multC (l r) (* (interp l fds) (interp r fds))]
    [idC (_) (error 'interp "sholdn't get here")]
    [appC (f a) (local ([define fd (get-fundef f fds)])
                  (interp (subst a
                                 (fdC-arg fd)
                                 (fdC-body fd))
                          fds))]
    ))

;(fdC ’double ’x (plusC (idC ’x) (idC ’x)))
; DONE
(interp (appC 'double (numC 5)) (list (fdC 'const5 '_ (numC 5)) (fdC 'double 'x (plusC (idC 'x) (idC 'x)))))